TITLE SLOOP
	ENTRY RNOTE,DRWNT,RDRAW,SLOOP,CIRCLE,PSRT,RUNTHR
	EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF,SLR
	EXTERNAL EXP3.2,SIN,COS,ATAN2,PLTR,SIND,COSD,LIMIT

	RB←15↔RX←14↔RA←13↔R←12↔KK←11↔V←10↔RW←7↔RZ←6↔SY←5
SLOOP:	0
	FLTR SY,LIMIT+2  	;L,  = NUMB OF SEGMENTS IN CURVE.
;;	FLTR SY,PTR+=251	;L,  = NUMB OF SEGMENTS IN CURVE.
	MOVEM SY,RSEG#		;FLOATING PT VERSION
	FSBR SY,[1.0]		
	KIFIX V,SY		;INTEGER NUMB OF SEGS-1
	MOVE LIMIT+2  		;L,  = NUMB OF SEGMENTS IN CURVE.
;;	MOVE PTR+=251		;L,  = NUMB OF SEGMENTS IN CURVE.
	IDIVI 2
	MOVEM IHLF#		; 1/2 OF SEGS - INTEGER
	FLTR
	MOVEM RHLF#		; FLOATING PT 1/2
	
	SETZM CIRCLE	;WILL BE FLAG FOR REVERSING LOOP
	MOVE [1.0]
	MOVEM RDRAW
	MOVE	RB,.COMM.+=18	;RB=RX/71.
	FDVR	RB,SY
	SETZ	KK,	;DO 81 K=0,271
	SETZ RX,
SLR81:	MOVE	RA,RX
	FADR RX,[1.0]
	FMPR	RA,RB
	FADR	RA,.COMM.+4	;81	SLURX(K+1)=RB*(K)+R3
	MOVEM RA,SLR(KK)
	CAMGE	KK,V
	AOJA	KK,SLR81
	MOVE	RA,.COMM.+=8	;RA=R7*RST7
	FMPR	RA,.COMM.+=17
	SKIPN	RX,.COMM.+=10	;41	IF(R9.EQ.0)R9=RZZ
	MOVE	RX,[=2.8]	;RX IS R9
	SETZ RB,
SLR41:	MOVE	R,.COMM.+2	;R=R+RA    CENTR IS R
	FADR	R,RA
	MOVE V,.COMM.+=41	;THIS IS RJ
	MOVE KK,RHLF   		;JS=136
	SKIPLE V	 	;IF(RJ.GT.0)JS=272
	MOVE KK,RSEG   		;DO 40 K=JS,1,-1
	MOVEM KK,RNOTE		;RNOTE=JS  SAVE IT FOR DIVIDE LATER
	MOVNS	RA
	CAML  V,[200.0]		;IF(RJ.GE.200)SET REVERSE FLAG
	SETOM CIRCLE
	MOVE 2,.COMM.+=11	;IF R10 .NE. 0 SHIFT CENTER OF SLUR.
	JUMPLE 2,SLR40   ; SKIPS NEG OR 0 IN P10
	CAML 2,[1.0]	; SKIPS P10>1.0
	JRST SLR40
	CAML 2,[0.5]	; IS P10 .LT. .5??
	JRST .+4
	SETOM CIRCLE	; SET THE REVERSE FLAG
	MOVE [1.0]
	FSBRM 2
	MOVE KK,RSEG   
	FMPR KK,2	;KK=1ST 'HALF' OF SLUR
	MOVEM KK,RNOTE	 ;**** CANNOT USE P9 WITH P7>100!!!!!!
	MOVE RSEG   
	FSBR RNOTE
	MOVE 1,RNOTE		; INCR=RNOTE/(272-RNOTE)
	FDVR 1,
	MOVEM 1,RDRAW		;INCR. FOR 2ND 'HALF'
SLR40:	AOJ RB,		; L=L+1
	MOVE	2,KK		;RW=R-RA*(K/RNOTE)**R9
	FDVR	2,RNOTE  
	CAML 2,[0.1]	;NEXT IS TO AVOID UNDERFLOW IN EXP3.2
	JRST .+3
	MOVEM R,ALF(RB)
	JRST UNDER
	MOVE	3,RX
	PUSHJ	17,EXP3.2	; I HOPE! AC2=AC2**AC3
	FMPR	2,RA
	MOVE	RW,2
	FADR	RW,R
	MOVEM RW,ALF(RB)  ;SLURY(L)=RW	;ALF IS 1 BEFORE SLURY(1)
;;UNDER:	MOVE .COMM.+=41		;IF(RJ.GT.0)GO TO 40
;;	JUMPG RJ40
;;	MOVE 2,[73.0]	; NOW IT MUST BE FLOATING POINT
;;	FSBR 2,V	;VARIABLE LENGTH 2ND 'HALF' OF SLUR
;;	FIXX(2)	
;;	FADR V,RDRAW	;ADD THE NOW VARIABLE INCR. 2/76
;;	MOVEM RW,ALF(2)
UNDER:	CAMG KK,[1.0]	;40 CONTINUE	
	JRST .+3
	FSBR KK,[1.0]		; INCREMENT--SUBTRACT IT.
	JRST SLR40		; LOOP BACK
	MOVE 2,RNOTE 
	CAME 2,RSEG   	; JUMP IF HALF SLURS WERE DRAWN (R7>100)
	JRST SLR4
SLR5:	JUMPE V,.+3	; CHECK FOR REVERSE FEATURE.
	MOVE 1,CIRCLE
	JUMPGE 1,SLR3	;NO RETRO NECESSARY
	MOVEI KK,1
	MOVE RB,LIMIT+2   ;PUT DIFF. INTO JA FOR 2ND AND 3RD TIMES AROUND
	MOVE RZ,IHLF
	MOVE SY,ALF(RZ) 		; MID-POINT OF SLUR
	MOVE R,.COMM.+1		;IF(JA.EQ.5)GO TO SLR6
	CAIN R,5
	JRST SLR6
	MOVE 2,ALF(RZ)  ;DO ALL THIS ONLY 2ND AND 3RD TIMES.
	FSBR 2,R
	FADR 2,2
	FDVR 2,RHLF   ;GET RIGHT PORTION OF DIFF. BETWEEN CURVES.
	MOVE 1,RHLF   	; SET THE COUNTER
SLR6:	MOVE RZ,ALF(RB)		; THIS LOOP REVERSES ALL Y COORDS.
	EXCH RZ,ALF(KK)
	JUMPN V,SLR7
	MOVE RZ		; SAVE IT FOR NOW
	FSBR RZ,SY
	FADR RZ,RZ
	MOVNS RZ
	FADR RZ,	; PUTS POINT UP WHERE IT NOW SHOULD BE.
	CAIN R,5	;IF(JA.EQ.5)SET UP FOR NEXT TIMES AROUND
	JRST SLR7
	MOVE 2		; GET THE FACTOR
	FMPR 1		; MULT BY THE COUNTER
	FSBR RZ,	; SUBTR. IT FROM THIS POINT ON THE CURVE
	FSBR 1,[1.0]	;UPDATE COUNTER
SLR7:	MOVEM RZ, ALF(RB)
	CAMN KK,IHLF 
	JRST SLR1		; ALL DONE
	SOJ RB,
	AOJA KK,SLR6

SLR4:	MOVE RZ,LIMIT+2 	;PUT L INTO RZ
	MOVE RB,RDRAW	;'HALF' INCR.
	MOVE KK,[1.0]

SLR2:	KIFIX SY,KK	; PUTS 1ST 'HALF' DATA INTO 2ND 'HALF'
	MOVE 2,ALF(SY)	;   CAN BE USED FOR 'REVERSED' SLURS!
	MOVEM 2,ALF(RZ)
	FADR KK,RB	;KK=KK+INCRX
	CAMLE KK,RNOTE	; IS KK PAST THE 'MIDDLE'?
	JRST SLR5	; YES
	SOJ RZ,		; NO, SUBTRACT ONE
	JRST SLR2

SLR1:	CAIE R,5
	JRST SLR3
	MOVE R,IHLF
	MOVE R,ALF(R)      ;STORE MID-POINT OF SLUR IN JA'S AC.
	MOVEM R,.COMM.+1
SLR3:	MOVE	2,.COMM.+=20	;89	IF(RTILT.EQ.0)GO TO 87
	JUMPE	2,SLR87		;RETURNS
	JSA	16,ATAN2	;RW=ATAN2(RTILT,RXX)
	JUMP	.COMM.+=20
	JUMP	.COMM.+=19
	MOVE	RW,0
	JSA	16,SIN		;RA=SIN(RW)
	JUMP	RW		; ????
	MOVE	RA,0
	JSA	16,COS		;RB=COS(RW)
	JUMP	RW
	MOVE	RB,0
	MOVE	RZ,SLR		;RZ=SLURX(1)
	MOVE	RW,ALF+1		;RW=SLURY(1)
	MOVEI	KK,SLR		;DO 83 K=1,L
	MOVE 	4,LIMIT+2 	; GET L
	ADDI	4,-1(KK)	;ADR. OF SLURX(L+1)
	MOVEI	SY,ALF+1
SLR83:	MOVE	R,(KK)	;R=SLURX(K)-RZ
	FSBR	R,RZ
	MOVE	RX,(SY)		;RXX=SLURY(K)-RW
	FSBR	RX,RW
	MOVN	2,RA	;SLURX(K)=RB*R-RA*RXX+RZ
	FMPR	2,RX
	FADR	2,RZ
	MOVE	3,R
	FMPR	3,RB
	FADR 	3,2
	MOVEM	3,(KK)
	MOVE	2,RA		;83	SLURY(K)=RB*RXX+RA*R+RW
	FMPR	2,R
	FADR	2,RW
	MOVE	3,RX
	FMPR	3,RB
	FADR	3,2
	MOVEM	3,(SY)
	AOJ	SY,
	CAIGE	KK,(4)
	AOJA	KK,SLR83
SLR87:	JRA	16,(16)
A:	0
B:	0
L:	0

RNOTE:	0	;	SUBROUTINE RNOTE(X)
	MOVE	2,@(16)	;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
	JSA	16,AMOD	;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
	JUMP	2
	JUMP	[=1000.0]
	KIFIX	2,0
	MOVE 3,PTR-1(2)
	MOVE 3,XRN-1(3)
	MOVEM	3,@(16)
	JRA	16,1(16)	; END

DRWNT:	0   	;	SUBROUTINE DRWNT  [RMINI IS ALF+=49]
	MOVE	2,.COMM.+2	;COMMON /STF/RSTFAC(0/7),RSTJ2
	MOVEM	2,A
	SETZM	.COMM.+=29	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)	
	MOVE	2,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
	MOVEM	2,B
	MOVE	2,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
	MOVEM	2,L		 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
	MOVE	2,ALF+=49	;RJX=CENTR
	FMPR	2,[=0.5]	;JH=0  J8
	FDVR	2,STF+=8   ;RA=R6  JH=0  SO IT WILL FILL. (P8 IN 'CLEFS')
	MOVEM	2,.COMM.+7		;R6=.5*RMINI/RSTJ2
	MOVEM	2,.COMM.+=8		;R7=R6
;;	MOVE	2,.COMM.+=23	;RJD=RJZ-3
	MOVE 2,.COMM.+=23	;THIS IS RJZ IN NTS
	FSBR	2,[=3.0]
	MOVEM	2,.COMM.+5   ;  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
	SETZM	.COMM.+=30		;JI=0
	MOVE 2,.COMM.+=9	;SAVE R8
	MOVEM 2,RDRAW		;R8 MUST BE 0 IN CLEFS (TO AVOID THICKENER)
	SETZM .COMM.+=9
	JSA	16,CLEFS	;CALL CLEFS
	MOVE 2,RDRAW
	MOVEM 2,.COMM.+=9	;GET BACK R8
	KIFIX	2,.COMM.+=10
	MOVEM	2,.COMM.+=30	;JI=R9  (I SAVED JI IN 2)
;  ↑↑↑↑↑↑ NEEDED??
;  FOR WHITE NOTES AND ACCIS ON PLOTTER.
	MOVE	2,A
	MOVEM	2,.COMM.+2		;CENTR=RJX
	MOVE	2,L
	MOVEM	2,.COMM.+7		;R6=RA
	FLTR	2,.COMM.+=28	; FLOAT IT.
	MOVEM	2,.COMM.+=8	;R2=JG
	KIFIX	2,.COMM.+6
	MOVEM	2,.COMM.+=26	;JE=RJE	
	JRA	16,(16) 	;END	(ALIGNMENT ABOVE IS OFF!)

RDRAW:	0  ;	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
	MOVEI	2,@2(16) ;C   TO X,Y INTO ONE WORD
	ADD	2,@(16)		;DIMENSION XY(1)
	KIFIX	3,@1(16)	;DO 2 K=I,IFIX(S)
	MOVEI	10,@2(16)
	ADDI	10,(3)
	MOVEM	10,DRWNT	;SAVE IT FOR NOW
RD2:	MOVEI	4,2		; L=2
	MOVE	5,-1(2)		; Y=XY(K)
	CAMGE	5,[=1000.0]	;IF(Y.LT.1000.)GO TO 3
	JRST	RD3
	MOVEI	4,3		;L=3
	FSBR	5,[=1000.0]	;Y=Y-1000.
;   >1000 = INVIS. LINE
RD3:	KIFIX	6,5	;3	M=Y
	MOVEM	4,L
	FLTR	7,6	;Y=(Y-M)*1000.
	FSBR	5,7
	FMPR	5,[=1000.0]	; Y
	CAMG	5,[=100.0]	;IF(Y.GT.100.)Y=100-Y
	JRST 	RD4
	FSBR	5,[=100.0]
	MOVNS	5
RD4:	FMPR	5,@3(16)
;   Y NUMBERS .GT.100 ARE NEG.
	FADR	5,@5(16)	;B=Y*X+CENTR
	CAIG	6,=60		;IF(M.GT.60)M=100-M
	JRST	RD5
	SUBI	6,=100
	MOVNS	6
RD5:	FLTR 6,6             ;	A=M*RMINI+R3
	FMPR	6,@6(16)
	FADR	6,@4(16)
	MOVEM	6,A
	MOVEM	5,B
	MOVEM	2,RNOTE		;SAVE IT FOR A SECOND
	JSA	16,LINES	;2	CALL LINES(A,B,L)
	JUMP	A
	JUMP	B
	JUMP	L
	MOVE	2,RNOTE
	CAMGE	2,DRWNT
	AOJA	2,RD2
	JRA	16,7(16)

CIRCLE:	0		;	RA=5.96*RSJT2*R5
	MOVE	RA,.COMM.+6
	FMPR	RA,[=5.96]
	FMPR	RA,STF+=8
	FLTR	RB,.COMM.+=29	;J8=J8*RDIS
	FMPR	RB,PLTR+2
	MOVE	RX,.COMM.+=28	;IF(J7.LE.J6)J7=J7+360
	CAMLE	RX,.COMM.+=27	;RX IS J7
	JRST	C2
	ADDI	RX,=360
C2:	MOVEI	RZ,6	;	KQ=6
	MOVE	2,PLTR		;IF(PLT)KQ=1
	SKIPGE	2
	MOVEI	RZ,1		
	MOVEM	RZ,DRWNT	; DRWNT IS KQ
C10:	MOVE	KK,.COMM.+=27	;10	DO 3 K=J6,J7,KQ
	MOVEI	V,3		;L=3
	MOVEM	V,L
C3:	FLTR	R,KK		;R=K
	MOVEM	R,A  ;CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
	JSA	16,SIND
	JUMP	A
	FMPR	0,RA
	FADR	0,.COMM.+4
	MOVEM	0,B
	JSA	16,COSD
	JUMP	A
	FMPR	0,RA
	FADR	0,.COMM.+2
	MOVEM	0,A
	JSA	16,LINES
	JUMP	B
	JUMP	A
	JUMP	L
	MOVEI	V,2	;3	L=2
	MOVEM	V,L
	ADD	KK,DRWNT
	CAIG	KK,(RX)
	JRST	C3 
	FSBR	RB,[1.0]	;J8=J8-1
	JUMPL	RB,SLR87	;IF(J8)RETURN
	MOVE	2,[1.0]		;RA=RA+1/RDIS
	FDVR	2,PLTR+2
	FADR	RA,2
	JRST 	C10		;GO TO 10
;JA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
			;RETURN

PPP:	BLOCK =300	;THIS WAS 250 - 2/78

;;	SUBROUTINE PSRT(P)
;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
;;	IMPLICIT INTEGER(S-Z)
;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔R←12↔RN←13↔K←14
PSRT:	0	;	DO 4 K=1,ITEM
	MOVEI	K,PPP		; ADR OF P
	MOVEI	MM,PTR		;L=PWDS(K)
	MOVEI RB,(MM)
	MOVE	NN,LIMIT+1  	; ITEM
;;	MOVE	NN,PTR+=250	; ITEM
	ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
	MOVE SY,[16.0]
PL4:	MOVE	R,(MM)		;LL=PWDS(K-1)
				;LM=PWDS(K+1)
				;A=RN(L+3)
				;P(K)=A+1000*RN(L+2)
	MOVE AA,XRN+2(R)
	MOVE J,XRN+1(R)
	FMPR	J,[=1000.0]
	FADR	J,XRN+2(R)	; IF(RN(L+1).NE.16)GO TO 40
	MOVE V,XRN(R)
	CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
	JRST	PLA
	FSBR	J,[=16.0]
	MOVE	AA,[=1000.0]
PLA:	MOVEM	J,(K)
	CAME V,SY
	JRST	PL40
	CAIN RB,(MM)
	JRST PLAQ		;IF (K.EQ.1) GO TO PLAQ
	MOVE	Y,-1(MM)	;Y=PWDS(K-1)
	CAMN SY,XRN(Y)
	JRST 	PL41
PLAQ:	MOVE	V,1(MM)		;V=PWDS(K+1) ;IF(RN(V+1).EQ.16)GO TO 41
	CAMN SY,XRN(V)
	JRST	PL41
	JRST	PLS		;GO TO 4
PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
	MOVEM	AA,(K)
PLS:	CAIL	MM,(NN)	;4	CONTINUE
	JRST	PLX
	AOJ	MM,
	AOJA	K,PL4
;  PLOTS ALL NEG. POSITIONS FIRST.
PLX:	MOVE	AA,LIMIT+3  	;IX=I
	MOVEM	AA,LIMIT+4  
	CAIL	AA,=1500		;IF(I.LT.1500)I=1500
	JRST 	PLY
	MOVEI	AA,=1500
	MOVEM	AA,LIMIT+3 
PLY:	MOVEI	Y,(AA)		;	Y=I
	ADD	AA,LIMIT+4 	;I=I+IX-1
	SUBI	AA,1
	MOVEM	AA,LIMIT+3 
	MOVEM	Y,LIMIT+4 	;IX=Y
;  IX IS M IN MAIN PROG.
;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
PL2:	MOVE	AA,PPP  		;2	A=P(1)
	MOVEI	R,1		;L=1
	MOVEI	J,1
	MOVEI	K,PPP  		;DO 1 K=1,ITEM
	MOVE	NN,LIMIT+1 
	ADDI	NN,(K)	;P(ITEM)
PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
	JRST	PLZ
	MOVE	AA,(K)		;A=P(K)
	MOVE	R,J		;L=K
PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
	JRST	PLW
	AOJ	K,
	AOJA	J,PL1
PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
	JRA	16,(16)
;  ALL ITEMS HAVE NOW BEEN SHUFFLED
	MOVEI	V,PTR		;V=PWDS(L)
	ADDI	V,(R)
	MOVE	V,-1(V)
	MOVE	AA,[=10000.0]	;P(L)=10000
	MOVEI	J,PPP  
	ADDI	J,(R)
	MOVEM	AA,-1(J)
	MOVEI	R,XRN		;L=RN(V)+2+Y
	ADDI	R,(V)
	KIFIX	R,-1(R)
	ADDI	R,2
	ADDI	R,(Y)
	SUBI	V,(Y)		;V=V-Y
	MOVEI	K,XRN		;DO 3 K=Y,L
	ADDI	K,(Y)
	MOVEI	NN,XRN
	ADDI	NN,(R)
PL3:	MOVEI	AA,(K)
	ADDI	AA,(V)		;3	RN(K)=RN(K+V)
	MOVE	AA,-1(AA)
	MOVEM	AA,-1(K)
	CAIGE	K,(NN)
	AOJA	K,PL3
;; REPLACED SUBROUTINE LOOP
	MOVEI	Y,(R)		;Y=L+1
	ADDI	Y,1
	JRST	PL2		;GO TO 2

RUNTHR:	0	; CALL RUNTHR(M)
	MOVE	5,@(16)	;GET M
	MOVEI	2,XRN	;GET RN LOC.
	ADDI	2,(5)	;2=LOC OF RN(M+1)
	KIFIX	3,-1(2)		;3=CNT
	KIFIX	4,(2)		;M+1
	MOVEM	4,.COMM.+1	;JA=RN(M+1)
	ADDI	5,2		;M=M+2
	ADDI	2,1		; LOC OF RN(M) NOW
	MOVE	6,(2)
	MOVEM	6,.COMM.	;R2=RN(M)	
	MOVEI	13,.COMM.	;LOC OF COMMON BLOCK
	SETZ	7,	;K=0
LP:	MOVEI	12,.COMM.
	ADDI	12,(7)	
	CAML	7,3		;ARE WE PAST COUNT?
	JRST	LZRO		;YES
	MOVEI	10,(5)
	ADDI	10,(7)		;M+K
	MOVEI	11,XRN
	ADDI	11,(10)		;LOC OF RN(M+K)
	MOVE	11,(11)
	MOVEM	11,4(12)	;RJQ(K)=RN(M+K)
	KIFIX 11,11
	MOVEM	11,=24(12)	;JQ(K)=
	JRST	LB
LZRO:	SETZM	4(12)		;RJQ(K)=0
	SETZM	=24(12)		;JQ(K)=0
LB:	CAIE	7,=9	; LESS THAN 10?
	AOJA	7,LP
	ADDI	5,(3)	; M=CNT+M+1
	ADDI	5,1
	MOVEM	5,@(16)
	JRA	16,1(16)

	END